home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_80 / cdinfo.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  7KB  |  267 lines
  1. library CDInfo;
  2. {
  3.   Programmer: Charlie Calvert
  4.   Thanks: Mark C. Paxton
  5.  
  6.   Copyright (c) June 1993, by Charlie Calvert
  7.   Feel free to use this code as an adjunct to your own programs.
  8. }
  9.  
  10. uses
  11.   MMSystem,
  12.   PlayInfo,
  13.   Strings,
  14.   WinProcs,
  15.   WinTypes;
  16.  
  17. function OpenCD(PWindow: HWnd): Boolean; export;
  18. var
  19.   Info : TMCI_Open_Parms;
  20.   RC   : LongInt;
  21.   Flags: LongInt;
  22.   S1: array[0..MsgLen] of Char;
  23.  
  24. begin
  25.   OpenCD := True;
  26.   FillChar(Info, SizeOf(TMCI_Open_Parms), #0);
  27.   Info.dwCallback := PWindow;
  28.   Info.lpstrDeviceType:=PChar(MCI_DEVTYPE_CD_AUDIO);
  29.   Flags := MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID;
  30.   RC := mciSendCommand(0, MCI_OPEN, Flags, Longint(@Info));
  31.  
  32.   wDeviceId := Info.wDeviceId;
  33.  
  34.   if RC<>0 then begin
  35.     ErrorMsg(RC, S1);
  36.     OpenCD := False;
  37.   end;
  38. end;
  39.  
  40. procedure SetMSFasFormat; export;
  41. var
  42.   Info: TMCI_Set_Parms;
  43.   RC  : LongInt;
  44.   S1  : array[0..MsgLen] of Char;
  45.  
  46. begin
  47.  
  48.   Info.dwCallback := 0;
  49.   Info.dwTimeFormat := MCI_FORMAT_MSF;
  50.   Info.dwAudio := 0;
  51.  
  52.   RC:=mciSendCommand( wDeviceId,
  53.                       MCI_SET,
  54.                       MCI_SET_TIME_FORMAT,
  55.                       Longint(@Info));
  56.  
  57.   if RC<>0 then ErrorMsg(RC, S1);
  58. end;
  59.  
  60. procedure SetTMSFasFormat; export;
  61. var
  62.   Info: TMCI_Set_Parms;
  63.   RC  : LongInt;
  64.   S1  : array[0..MsgLen] of Char;
  65.  
  66. begin
  67.   Info.dwCallback := 0;
  68.   Info.dwTimeFormat := MCI_FORMAT_TMSF;
  69.   Info.dwAudio := 0;
  70.  
  71.   RC:=mciSendCommand( wDeviceId, MCI_SET,
  72.                       MCI_SET_TIME_FORMAT, Longint(@Info));
  73.  
  74.   if RC<>0 then ErrorMsg(RC, S1);
  75. end;
  76.  
  77. procedure PlayCDOneTrack(StartTrack:Byte); export;
  78. var
  79.   Info   : TMCI_Play_Parms;
  80.   Flags,
  81.   RC     : LongInt;
  82.   S1     : array[0..MsgLen] of Char;
  83. begin
  84.   FillChar(Info, SizeOf(TMCI_Play_Parms), 0);
  85.   Info.dwFrom := MCI_MAKE_TMSF(StartTrack,0,0,0);
  86.  
  87.   Flags := MCI_FROM or MCI_Notify;
  88.   RC := mciSendCommand( wDeviceId, MCI_PLAY, Flags, Longint(@Info));
  89.  
  90.   if RC<>0 then ErrorMsg(RC, S1);
  91. end;
  92.  
  93. procedure PlayMciCD(StartTrack,EndTrack:Byte); export;
  94. var
  95.   Info   : TMCI_Play_Parms;
  96.   Flags,
  97.   RC     : LongInt;
  98.   S1     : array[0..MsgLen] of Char;
  99.  
  100. begin
  101.   FillChar(Info, SizeOf(TMCI_Play_Parms), 0);
  102.   Info.dwFrom := MCI_MAKE_TMSF(StartTrack,0,0,0);
  103.   Info.dwTo   := MCI_MAKE_TMSF(EndTrack,  0,0,0);
  104.  
  105.   Flags := MCI_FROM or MCI_TO or MCI_Notify;
  106.   RC := mciSendCommand(wDeviceId, MCI_PLAY, Flags, Longint(@Info));
  107.  
  108.   if RC<>0 then ErrorMsg(RC, S1);
  109. end;
  110.  
  111. function GetNumTracks: LongInt; export;
  112. var
  113.   Status: TMCI_Status_Parms;
  114.   RC    : LongInt;
  115.   S1    : array[0..MsgLen] of Char;
  116.  
  117. begin
  118.   Status.dwCallback := 0;
  119.   Status.dwReturn   := 0;
  120.   Status.dwItem     := MCI_STATUS_NUMBER_OF_TRACKS;
  121.   Status.dwTrack    := 0;
  122.   RC := mciSendCommand(wDeviceId, MCI_STATUS,
  123.                       MCI_STATUS_ITEM, Longint(@Status));
  124.   if RC<>0 then ErrorMsg(RC, S1);
  125.   GetNumTracks := Status.dwReturn;
  126. end;
  127.  
  128. {---------------------------------------------------------------
  129.    Track information is stated in minutes and seconds relative
  130.    to the beginning of the disc. The durations of each song can
  131.    be constructed by subtracting the begin time of a song from the
  132.    begin time of the previous song.
  133. ----------------------------------------------------------------}
  134. procedure GetTrackLength(TrackNum: LongInt; var Min, Sec, Frame: Byte); export;
  135. var
  136.   Status         : TMCI_Status_Parms;
  137.   RC             : LongInt;
  138.   MSF            : LongInt;
  139.   MessageText    : array[0..128] of Char;
  140. begin
  141.   Status.dwTrack    := TrackNum;
  142.   Status.dwCallback := 0;
  143.   Status.dwReturn   := 0;
  144.   Status.dwItem     := MCI_STATUS_LENGTH;
  145.  
  146.   RC := mciSendCommand(wDeviceId, MCI_STATUS,
  147.                      MCI_STATUS_ITEM or MCI_TRACK,
  148.                      Longint(@Status));
  149.  
  150.   if RC <> 0 then ErrorMsg(RC, 'Could not get track length');
  151.  
  152.   MSF :=Status.dwReturn;
  153.   Min := MCI_MSF_MINUTE(MSF);
  154.   Sec := MCI_MSF_SECOND(MSF);
  155.   Frame := MCI_MSF_FRAME(MSF);
  156. end;
  157.  
  158. {---------------------------------------------------------------
  159.  
  160. ----------------------------------------------------------------}
  161. procedure GetLengthOfEachTrack(TrackNum: LongInt; Min, Sec, Frame: Byte);
  162. var
  163.   Status: TMCI_Status_Parms;
  164.   RC,
  165.   Flags,
  166.   MSF   : LongInt;
  167.   S1    : array[0..128] of Char;
  168.  
  169. begin
  170.   MessageBox(0, 'Function not ready', '', mb_Ok);
  171.   exit;
  172.  
  173.   Status.dwTrack    := TrackNum;
  174.   Status.dwCallback := 0;
  175.   Status.dwReturn   := 0;
  176.   Status.dwItem     := MCI_STATUS_LENGTH;
  177.   Flags := MCI_STATUS_ITEM or MCI_TRACK;
  178.   RC := mciSendCommand( wDeviceId, MCI_STATUS, Flags, Longint(@Status));
  179.  
  180.   if RC<>0 then begin
  181.     ErrorMsg(RC, S1);
  182.     exit;
  183.   end;
  184.  
  185.   MSF:=Status.dwReturn;
  186.   Min := MCI_MSF_MINUTE(MSF);
  187.   Sec :=  MCI_MSF_SECOND(MSF);
  188.   Frame :=   MCI_MSF_FRAME(MSF);
  189. end;
  190.  
  191. {  GetCurrentTrack; }
  192. function GetCurrentCDTrack: LongInt; export;
  193. {
  194.   TMCI_Status_Parms = record
  195.     dwCallback: Longint;
  196.     dwReturn: Longint;
  197.     dwItem: Longint;
  198.     dwTrack: Longint;
  199.   end;
  200. }
  201. var
  202.   Status           : TMCI_Status_Parms;
  203.   RC               : LongInt;
  204.   S1               : array[0..MsgLen] of Char;
  205.  
  206. begin
  207.   FillChar(Status, SizeOf(Status), #0);
  208.   Status.dwItem     := MCI_STATUS_CURRENT_TRACK;
  209.  
  210.   RC := mciSendCommand(wDeviceId, MCI_STATUS,
  211.                        MCI_STATUS_ITEM, Longint(@Status));
  212.  
  213.   if RC<>0 then ErrorMsg(RC, S1);
  214.   GetCurrentCDTrack := Status.dwReturn;
  215. end;
  216.  
  217. function HasDiskInserted: Boolean; export;
  218. var
  219.   Status : TMCI_Status_Parms;
  220.   RC     : LongInt;
  221.   Flags  : LongInt;
  222.   S1     : array[0..MsgLen] of Char;
  223.  
  224. begin
  225.   FillChar(Status, SizeOf(TMCI_Status_Parms), 0);
  226.   Status.dwItem := MCI_STATUS_MEDIA_PRESENT;
  227.  
  228.   Flags := MCI_STATUS_ITEM;
  229.   RC:=mciSendCommand(wDeviceID, MCI_STATUS, Flags, Longint(@Status));
  230.  
  231.   if RC<>0 then ErrorMsg(RC, S1);
  232.   HasDiskInserted := (Status.dwReturn > 0);
  233. end;
  234.  
  235.  
  236. procedure EjectCD;
  237. var
  238.   Info   : TMCI_Set_Parms;
  239.   Flags,
  240.   RC     : LongInt;
  241.   S1     : array[0..128] of Char;
  242.  
  243. begin
  244.   FillChar(Info, SizeOf(TMCI_Set_Parms), 0);
  245.   Flags := mci_Set_Door_Open;
  246.   RC:=mciSendCommand( wDeviceId, MCI_SET, Flags, Longint(@Info));
  247.   if RC<>0 then ErrorMsg(RC, S1);
  248. end;
  249.  
  250. exports
  251.   OpenCD index 1,
  252.   SetMSFasFormat index 2,
  253.   SetTMSFasFormat index 3,
  254.   PlayMciCD index 4,
  255.   GetNumTracks index 5,
  256.   GetTrackLength index 6,
  257.   StopMci index 7,
  258.   CloseMci index 8,
  259.   HasDiskInserted index 9,
  260.   GetDeviceID index 10,
  261.   PlayCDOneTrack index 11,
  262.   GetMode index 12,
  263.   GetCurrentCDTrack index 13,
  264.   GetLocation index 14;
  265.  
  266. begin
  267. end.